Analiza materiałów wykorzystywanych w tworzeniu baterii

Podsumowanie

Analiza przeprowadzona w tym raporcie koncentrowała się na badaniu zależności między różnymi właściwościami baterii. Główne spostrzeżenia obejmują:

• Dominującym głównym jonem baterii jest lit, który stanowi 50% wszystkich badanych baterii.
• Baterie wapniowe mogą być dobrą alternatywą do litowo-jonowych, ponieważ mają dużą gęstość energii (największą z badanych jonów), większą pojemność oraz lepszy wskaźnik stabilności. To powoduje, że mogą one oferować obiecującą wydajność i wyższy poziom bezpieczeństwa.
• Silne korelacje między parametrami wolumetrycznymi i grawimetrycznymi.
• Silne korelacje między gęstością energii i pojemnością.
• Model regresji osiągnął wysoki współczynnik determinacji (R²), co wskazuje na dobrą jakość predykcji gęstości energii wolumetrycznej.

Przeprowadzona analiza może być przydatna w dalszych badaniach oraz w praktycznych zastosowaniach projektowania akumulatorów.

Załadowanie bibliotek

library(dplyr)
library(ggplot2)
library(kableExtra)
library(tidyr)
library(plotly)
library(corrplot)
library(ggcorrplot)
library(caret)

Podstawowe statystyki

• Rozmiar zbioru danych: 4351 wierszy i 17 kolumn
• Liczba brakujących wartości: 0

Zbiór nie zawiera pustych wartości

	Battery.ID	Battery.Formula	Working.Ion	Formula.Charge	Formula.Discharge	Max.Delta.Volume	Average.Voltage	Gravimetric.Capacity	Volumetric.Capacity	Gravimetric.Energy	Volumetric.Energy	Atomic.Fraction.Charge	Atomic.Fraction.Discharge	Stability.Charge	Stability.Discharge	Steps	Max.Voltage.Step
	Length:4351	Length:4351	Length:4351	Length:4351	Length:4351	Min. : 0.00002	Min. :-7.755	Min. : 5.176	Min. : 24.08	Min. :-583.5	Min. :-2208.1	Min. :0.00000	Min. :0.007407	Min. :0.00000	Min. :0.00000	Min. :1.000	Min. : 0.0000
	Class :character	Class :character	Class :character	Class :character	Class :character	1st Qu.: 0.01747	1st Qu.: 2.226	1st Qu.: 88.108	1st Qu.: 311.62	1st Qu.: 211.7	1st Qu.: 821.6	1st Qu.:0.00000	1st Qu.:0.086957	1st Qu.:0.03301	1st Qu.:0.01952	1st Qu.:1.000	1st Qu.: 0.0000
	Mode :character	Mode :character	Mode :character	Mode :character	Mode :character	Median : 0.04203	Median : 3.301	Median : 130.691	Median : 507.03	Median : 401.8	Median : 1463.8	Median :0.00000	Median :0.142857	Median :0.07319	Median :0.04878	Median :1.000	Median : 0.0000
	NA	NA	NA	NA	NA	Mean : 0.37531	Mean : 3.083	Mean : 158.291	Mean : 610.62	Mean : 444.1	Mean : 1664.0	Mean :0.03986	Mean :0.159077	Mean :0.14257	Mean :0.12207	Mean :1.167	Mean : 0.1503
	NA	NA	NA	NA	NA	3rd Qu.: 0.08595	3rd Qu.: 4.019	3rd Qu.: 187.600	3rd Qu.: 722.75	3rd Qu.: 614.4	3rd Qu.: 2252.3	3rd Qu.:0.04762	3rd Qu.:0.200000	3rd Qu.:0.13160	3rd Qu.:0.09299	3rd Qu.:1.000	3rd Qu.: 0.0000
	NA	NA	NA	NA	NA	Max. :293.19322	Max. :54.569	Max. :2557.627	Max. :7619.19	Max. :5926.9	Max. :18305.9	Max. :0.90909	Max. :0.993333	Max. :6.48710	Max. :6.27781	Max. :6.000	Max. :26.9607

Zawartość zbioru

Battery.ID	Battery.Formula	Working.Ion	Formula.Charge	Formula.Discharge	Max.Delta.Volume	Average.Voltage	Gravimetric.Capacity	Volumetric.Capacity	Gravimetric.Energy	Volumetric.Energy	Atomic.Fraction.Charge	Atomic.Fraction.Discharge	Stability.Charge	Stability.Discharge	Steps	Max.Voltage.Step
mp-30_Al	Al0-2Cu	Al	Cu	Al2Cu	3.043399	0.0890331	1368.481	5562.790	121.84009	495.27253	0.0	0.6666667	0.0000000	0.0000000	1	0
mp-1022721_Al	Al1-3Cu	Al	AlCu	Al3Cu	1.243653	-0.0215863	1112.937	4418.980	-24.02423	-95.38962	0.5	0.7500000	0.0740612	0.0962458	1	0
mp-8637_Al	Al0-5Mo	Al	Mo	Al5Mo	4.762574	0.1227568	1741.504	7175.702	213.78156	880.86651	0.0	0.8333333	0.4114601	0.0452120	1	0
mp-129_Al	Al0-12Mo	Al	Mo	Al12Mo	12.723893	0.0431214	2298.811	7346.232	99.12801	316.78006	0.0	0.9230769	0.0000000	0.0114456	1	0
mp-91_Al	Al0-12W	Al	W	Al12W	12.494598	0.0292342	1900.745	7332.719	55.56677	214.36621	0.0	0.9230769	0.0000000	0.0000000	1	0
mp-1055908_Al	Al0-12Mn	Al	Mn	MnAl12	18.236156	0.0397314	2547.693	7592.916	101.22330	301.67688	0.0	0.9230769	0.1454643	0.0000000	1	0

Czyszczenie zbioru danych

Bezwzględne wartości napięcia i energii

W związku z tym, że w baterii płynie prąd stały, do analizy wykorzystano średnią z wartości bezwzględnych napięć i energii zamiast RMS (średniej kwadratowej), która lepiej nadaje się do prądu zmiennego.

W celu ułatwienia dalszej analizy wyznaczono bezwzględną wartość napięć oraz energii. Ujemne wartości oznaczają przeciwną polaryzację napięcia, która nie wpływa na energię zgromadzoną w baterii.

data <- data %>%
  mutate(Average.Voltage = abs(Average.Voltage)) %>%
  mutate(Gravimetric.Energy = abs(Gravimetric.Energy)) %>%
  mutate(Volumetric.Energy = abs(Volumetric.Energy))

Usunięcie wartości odstających

Przed analizą danych konieczne było usunięcie wartości odstających (outliers), ponieważ mogły one zaburzyć analizę i doprowadzić do błędnych wniosków. Zastosowano metodę rozstępu ćwiartkowego (IQR), polegającą na obliczeniu przedziału międzykwartylowego i usunięciu wartości leżących poza tym przedziałem.

\[ \text{Outliers} = \{ x : x > Q3 + threshold \cdot IQR \; \text{or} \; x < Q1 - threshold \cdot IQR \} \] threshold domyślnie jest ustawiony na 1,5.

Uwaga! W przypadku wystąpienia wartości odstającej w danej kolumnie usuwany jest cały wiersz, w którym się ona znajduje. Dzięki temu liczność każdej kolumny pozostaje taka sama. Takie podejście zastosowano, ponieważ analiza obejmuje zależności między atrybutami. Dodatkowo założono, że jeśli wartość jednego atrybutu jest odstająca, to pozostałe atrybuty w tym samym wierszu mogły zostać błędnie wyznaczone.

# Funkcja do oznaczania wierszy z wartościami odstającymi (tylko dla kolumn numerycznych)
remove_outliers_rowwise <- function(data, threshold = 1.5) {
  # Wybierz tylko numeryczne kolumny
  numeric_columns <- sapply(data, is.numeric)

  # Zastosuj funkcję tylko do numerycznych kolumn
  outlier_mask <- apply(data[, numeric_columns, drop = FALSE], 1, function(row) {
    # Sprawdzanie odstających wartości w każdym wierszu
    any(sapply(1:length(row), function(i) {
      col <- names(data)[numeric_columns][i]

      Q1 <- quantile(data[[col]], 0.25)
      Q3 <- quantile(data[[col]], 0.75)
      IQR <- IQR(data[[col]])

      row[col] < (Q1 - threshold * IQR) || row[col] > (Q3 + threshold * IQR)
    }))
  })

  # Zwróć dane bez wierszy z wartościami odstającymi
  data[!outlier_mask, ]
}

cleared_data <- remove_outliers_rowwise(data, 3)
# cleared_data <- data

Threshold musiał zostać zwiększony z 1.5 na 3, ponieważ przy domyślnej wartości prawie połowa zbioru została usunięta.

Liczba usuniętych wierszy przy threshold równym 3: 1218

Ekstrakcja atrybutów numerycznych

	Max.Delta.Volume	Average.Voltage	Gravimetric.Capacity	Volumetric.Capacity	Gravimetric.Energy	Volumetric.Energy	Atomic.Fraction.Charge	Atomic.Fraction.Discharge	Stability.Charge	Stability.Discharge	Steps	Max.Voltage.Step
70	0.0432028	3.5460914	74.742156	296.38931	265.04252	1051.02361	0.0000000	0.1111111	0.0111520	0.0447057	1	0
71	0.0066723	1.6879114	6.539716	35.11148	11.03846	59.26507	0.0545455	0.0714286	0.0000000	0.0000000	1	0
72	0.1070933	1.0948359	109.437374	463.71443	119.81597	507.69120	0.0000000	0.2500000	0.0095215	0.1766371	1	0
73	0.0415262	0.9598099	15.662905	114.64249	15.03341	110.03500	0.0000000	0.0666667	0.0000000	0.0082318	1	0
75	0.0625242	0.8756721	38.559152	179.95435	33.76518	157.58101	0.0000000	0.0666667	0.0000000	0.0221963	1	0
77	0.0383559	1.4088479	28.305532	155.34733	39.87819	218.86076	0.0000000	0.0666667	0.0000000	0.0000000	1	0

Przekształcenie danych do formatu długiego (long format)

Format danych został przekształcony tak, aby każdy atrybut i jego wartości znalazły się w dwóch osobnych kolumnach (Attribute i Value). Dzięki temu możliwe jest łatwiejsze tworzenie wykresów rozkładu wartości.

data_long <- numeric_data %>%
  pivot_longer(cols = everything(), names_to = "Atrybuty", values_to = "Wartości")

data_long

## # A tibble: 37,596 × 2
##    Atrybuty                   Wartości
##    <chr>                         <dbl>
##  1 Max.Delta.Volume             0.0432
##  2 Average.Voltage              3.55  
##  3 Gravimetric.Capacity        74.7   
##  4 Volumetric.Capacity        296.    
##  5 Gravimetric.Energy         265.    
##  6 Volumetric.Energy         1051.    
##  7 Atomic.Fraction.Charge       0     
##  8 Atomic.Fraction.Discharge    0.111 
##  9 Stability.Charge             0.0112
## 10 Stability.Discharge          0.0447
## # ℹ 37,586 more rows

Rozkłady gęstości atrybutów dla każdej kolumny

distribution_plots <- data_long %>%
  ggplot(aes(x = Wartości)) +
  geom_histogram(aes(y = ..density.., 
                     text = paste("Gęstość:", round(..density.., 2), "<br>Wartość:", scales::comma(..x..))),
                 bins = 30, color = "black", alpha = 0.5) + 
  geom_density(color = "red", size = 0.4) +  
  facet_wrap(~ Atrybuty, scales = "free", ncol = 3) +  
  theme_minimal() +
  theme(
    panel.spacing = unit(2, "lines"),
    axis.text.y = element_text(size = 8, margin = margin(r = 5)),
    plot.margin = margin(b = 20, r = 10)
  ) +
  labs(title = "Rozkłady wartości atrybutów", x = "Wartości", y = "Gęstość")

ggplotly(distribution_plots, tooltip = "text") %>%
  layout(hovermode = "x", width = 800)

Analiza wartości atrybutów

Liczba baterii w zależności od głównego jonu

batteries_by_ion <- cleared_data %>%
  group_by(Working.Ion) %>%
  summarize(n = n()) %>%
  arrange(desc(n))

count_batteries_plot <- ggplot(batteries_by_ion, aes(x = reorder(Working.Ion, n), y = n, text = paste("Liczba baterii:", n))) +
  geom_bar(stat = "identity", color = "black") +
  theme_minimal() +
  labs(title = "Liczba baterii w zależności od głównego jonu", x = "Główny jon", y = "Liczba baterii") +
  coord_flip()

ggplotly(count_batteries_plot, tooltip = "text")

Średnie napięcie dla różnych jonów

avg_voltage_by_ion <- cleared_data %>%
  group_by(Working.Ion) %>%
  summarize(avg_voltage = mean(Average.Voltage)) %>%
  arrange(desc(avg_voltage))

avg_voltage_plot <- ggplot(avg_voltage_by_ion, aes(x = reorder(Working.Ion, avg_voltage), y = avg_voltage, 
                                                   text = paste("Średnie napięcie:", round(avg_voltage, 2)))) +
  geom_col(color = "black") +
  theme_minimal() +
  labs(title = "Średnie napięcie dla różnych jonów", x = "Główny jon", y = "Średnie napięcie") +
  coord_flip()

ggplotly(avg_voltage_plot, tooltip = "text")

Porównanie gęstości energii dla każdego jonu

average_energies <- cleared_data %>%
  group_by(Working.Ion) %>%
  summarize(
    avg_gr_energy = mean(Gravimetric.Energy),
    avg_vol_energy = mean(Volumetric.Energy)
  ) %>%
  mutate(total_Energy = avg_gr_energy + avg_vol_energy) %>%
  arrange(desc(avg_vol_energy)) 

data_long <- average_energies %>%
  pivot_longer(
    cols = c(avg_gr_energy, avg_vol_energy),
    names_to = "energy_type",
    values_to = "avg_energy"
  ) %>%
  mutate(
    energy_type = recode(energy_type,
                         avg_gr_energy = "Energia grawimetryczna",
                         avg_vol_energy = "Energia wolumetryczna")
  )

energy_plot <- ggplot(data_long, aes(x = avg_energy, y = reorder(Working.Ion, avg_energy), 
                                     fill = energy_type, text = paste("Średnia gęstość energii:", round(avg_energy, 2)))) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(title = "Porównanie średniej wolumetrycznej i grawimetrycznej gęstości energii", 
       x = "Średnia gęstość energii", y = "Główny jon", fill = "Typ gęstości energii") +
    scale_fill_manual(values = c("#6D9EC1", "#E46726") 
  ) +
  theme_minimal()


ggplotly(energy_plot, tooltip = "text")

Porównanie pojemności dla każdego jonu

average_capacities <- cleared_data %>%
  group_by(Working.Ion) %>%
  summarize(
    avg_gr_capacity = mean(Gravimetric.Capacity),
    avg_vol_capacity = mean(Volumetric.Capacity)
  ) %>%
  mutate(total_capacity = avg_gr_capacity + avg_vol_capacity) %>%
  arrange(desc(avg_vol_capacity)) 

data_long_capacity <- average_capacities %>%
  pivot_longer(
    cols = c(avg_gr_capacity, avg_vol_capacity),
    names_to = "capacity_type",
    values_to = "avg_capacity"
  ) %>%
  mutate(
    capacity_type = recode(capacity_type,
                           avg_gr_capacity = "Pojemność grawimetryczna",
                           avg_vol_capacity = "Pojemność wolumetryczna")
  )

capacity_plot <- ggplot(data_long_capacity, aes(x = avg_capacity, y = reorder(Working.Ion, avg_capacity), 
                                                fill = capacity_type, 
                                                text = paste("Średnia pojemność:", round(avg_capacity, 2)))) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(title = "Porównanie średniej wolumetrycznej i grawimetrycznej pojemności", 
       x = "Średnia pojemność", y = "Główny jon", fill = "Typ pojemności") +
  scale_fill_manual(values = c("#6D9EC1", "#E46726")) +
  theme_minimal()

ggplotly(capacity_plot, tooltip = "text")

Porównanie udziału atomowego dla każdego jonu

average_fractions <- cleared_data %>%
  group_by(Working.Ion) %>%
  summarize(
    avg_atomic_fraction_charge = mean(Atomic.Fraction.Charge),
    avg_atomic_fraction_discharge = mean(Atomic.Fraction.Discharge)
  ) %>%
  mutate(total_fraction = avg_atomic_fraction_charge + avg_atomic_fraction_discharge) %>%
  arrange(desc(avg_atomic_fraction_discharge)) 

data_long_fractions <- average_fractions %>%
  pivot_longer(
    cols = c(avg_atomic_fraction_charge, avg_atomic_fraction_discharge),
    names_to = "fraction_type",
    values_to = "avg_fraction"
  ) %>%
  mutate(
    fraction_type = recode(fraction_type,
                           avg_atomic_fraction_charge = "Naładowany",
                           avg_atomic_fraction_discharge = "Rozładowany")
  )

fraction_plot <- ggplot(data_long_fractions, aes(x = avg_fraction, y = reorder(Working.Ion, avg_fraction), 
                                                 fill = fraction_type, 
                                                 text = paste("Średni udział atomowy:", round(avg_fraction, 2)))) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(title = "Porównanie średnich udziałów atomowych w <br>stanach naładowanym i rozładowanym", 
       x = "Średni udział atomowy", y = "Główny jon", fill = "Stan") +
  scale_fill_manual(values = c("#6D9EC1", "#E46726")) +
  theme_minimal()

ggplotly(fraction_plot, tooltip = "text")

Porównanie wskaźnika stabilności dla każdego jonu

average_stability <- cleared_data %>%
  group_by(Working.Ion) %>%
  summarize(
    avg_stability_charge = mean(Stability.Charge),
    avg_stability_discharge = mean(Stability.Discharge)
  ) %>%
  mutate(total_stability = avg_stability_charge + avg_stability_discharge) %>%
  arrange(desc(avg_stability_discharge)) 

data_long_stability <- average_stability %>%
  pivot_longer(
    cols = c(avg_stability_charge, avg_stability_discharge),
    names_to = "stability_type",
    values_to = "avg_stability"
  ) %>%
  mutate(
    stability_type = recode(stability_type,
                            avg_stability_charge = "Naładowany",
                            avg_stability_discharge = "Rozładowany")
  )

stability_plot <- ggplot(data_long_stability, aes(x = avg_stability, y = reorder(Working.Ion, avg_stability), 
                                                  fill = stability_type, 
                                                  text = paste("Średni wskaźnik stabilności:", round(avg_stability, 2)))) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(title = "Porównanie średniego wskaźnika stabilności w <br>stanach naładowanym i rozładowanym", 
       x = "Średni wskaźnik stabilności", y = "Główny jon", fill = "Stan") +
  scale_fill_manual(values = c("#6D9EC1", "#E46726")) +
  theme_minimal()

ggplotly(stability_plot, tooltip = "text")

Analiza korelacji między zmiennymi

Oczekiwana korelacja między pojemnościami

Duża korelacja między pojemnością grawimetryczną (gravimetric capacity) a pojemnością wolumetryczną (volumetric capacity) jest uzasadniona. Wynika to z faktu, że iloraz tych wartości odpowiada gęstości baterii:

\[ \frac{\text{Vc}}{\text{Gc}} = \frac{\text{mAh/cm}^3}{\text{mAh/g}} = \text{gęstość baterii (g/cm}^3\text{)}. \]

Oczekiwana korelacja między energiami

Podobne zależności można zaobserwować między wolumetryczną energią (volumetric energy) a grawimetryczną energią (gravimetric energy). Wysoka korelacja jest tutaj również uzasadniona, ponieważ ich iloraz odpowiada gęstości baterii:

\[ \frac{\text{Ve}}{\text{Ge}} = \frac{\text{Wh/L}}{\text{Wh/kg}} = \text{gęstość baterii (kg/L)}. \]

cor_matrix <- cor(numeric_data, use = "complete.obs")

correlation_plot <- ggcorrplot(
  cor_matrix, 
  hc.order = FALSE, 
  lab = TRUE, 
  type = "lower", 
  lab_size = 2.5,
  outline.col = "white",
  legend.title = "Korelacja",
  colors = c("#6D9EC1", "white", "#E46726")
) +
  theme_minimal(base_size = 10) +
  theme(
    axis.text.x = element_text(size = 8, angle = 45, vjust = 1, hjust = 1),
    axis.text.y = element_text(size = 8)
  ) +
  labs(title = "Analiza korelacji", x = "", y = "")

ggplotly(correlation_plot, tooltip = "text")

Dlaczego oczekiwane współczynniki korelacji nie osiągają wartości 1?

Chociaż współczynnik korelacji między pojemnościami i energiami w bateriach jest wysoki, nie osiąga wartości idealnej, czyli 1. Wynika to z faktu, że na gęstość baterii wpływa wiele czynników, nieograniczających się jedynie do głównego jonu użytego w materiale aktywnym.

Oprócz głównego jonu, istotny udział w gęstości mają pozostałe pierwiastki, takie jak dodatki stabilizujące strukturę materiału, przewodniki jonowe czy inne składniki elektrody. Ich obecność może wpływać zarówno na gęstość masową (g/cm³ lub kg/L), jak i na właściwości elektrochemiczne, takie jak napięcie czy zdolność do przechowywania energii.

Korelacja między pojemnością a energią

Silna korelacja między pojemnością grawimetryczną (gravimetric capacity) a grawimetryczną energią (gravimetric energy) nie była spodziewana. Jednak rzeczywiście można zauważyć, że ich iloraz jest równy wartości napięcia między zaciskami baterii.

Interpretacja współczynnika korelacji \(r\)

Wartości współczynnika korelacji \(r\) interpretuję zgodnie z poniższymi przedziałami:

• Bardzo silna korelacja: \(0.9 \leq |r| \leq 1\)
• Silna korelacja: \(0.7 \leq |r| < 0.9\)
• Umiarkowana korelacja: \(0.5 \leq |r| < 0.7\)
• Słaba korelacja: \(0.3 \leq |r| < 0.5\)

top_correlations <- function(cor_matrix, threshold = 0.7) {
  cor_matrix[lower.tri(cor_matrix, diag = TRUE)] <- NA
  cor_table <- as.data.frame(as.table(cor_matrix))
  cor_table <- cor_table[!is.na(cor_table$Freq) & abs(cor_table$Freq) >= threshold, ]
  cor_table <- cor_table[order(-abs(cor_table$Freq)), ] 
  cor_table %>%
    rename('Atrybut 1' = Var1, 'Atrybut 2' = Var2, 'Współczynnik korelacji' = Freq)
}

knitr::kable(top_correlations(cor_matrix, 0.7), caption = "Tabela silnych i bardzo silnych korelacji") %>%
  kable_styling(bootstrap_options = "striped", full_width = T)

Tabela silnych i bardzo silnych korelacji

	Atrybut 1	Atrybut 2	Współczynnik korelacji
65	Gravimetric.Energy	Volumetric.Energy	0.9052481
39	Gravimetric.Capacity	Volumetric.Capacity	0.8710103
63	Gravimetric.Capacity	Volumetric.Energy	0.7408972
51	Gravimetric.Capacity	Gravimetric.Energy	0.7265697
64	Volumetric.Capacity	Volumetric.Energy	0.7040137

Predykcja gęstości energii

W tej sekcji przedstawiono proces predykcji energii wolumetrycznej (Volumetric.Energy) na podstawie innych kluczowych atrybutów baterii. Do modelu użyto danych po usunięciu wartości odstających.

Wykorzystano model regresji liniowej, który został stworzony przy użyciu zbioru treningowego (80% danych). Zbiór testowy (20%) posłużył do oceny skuteczności predykcji.

Do oceny jakości modelu wykorzystano następujące metryki:

• RMSE (Root Mean Square Error) - średnia odległość pomiędzy wartościami przewidywanymi a rzeczywistymi. Im mniejsza, tym lepiej
• MAE (Mean Absolute Error) - średnia bezwzględna różnica między rzeczywistymi a przewidywanymi wartościami. Im mniejsza tym lepiej
• R² (współczynnik determinacji) - wskaźnik, który mówi, jak dobrze model dopasowuje się do danych (od 0 do 1, gdzie 1 oznacza idealne dopasowanie). Wykorzystany został współczynnik korelacji r-Pearsona podniesiony do kwadratu.

Dobór zmiennych do modelu

Analiza korelacji pomiędzy cechami ujawniła silne zależności między Volumetric.Energy a innymi atrybutami, co wymagało starannego doboru zmiennych do modelu. Z tego względu cecha Gravimetric.Energy została uwzględniona w modelu (r = 0.91). Natomiast z modelu wyłączono Gravimetric.Capacity i Volumetric.Capacity, ponieważ są one redundantne i mogą powodować problemy z multikolinearnością.

Po licznych próbach doboru najlepszych zmiennych końcowo do modelu włączono:

• Gravimetric.Energy - energia grawimetryczna,
• Stability.Charge - stabilność w czasie ładowania,
• Atomic.Fraction.Discharge - udział atomowy składników w stanie rozładowanym,
• Atomic.Fraction.Charge - udział atomowy składników w stanie naładowanym.

predictors <- numeric_data %>%
  select(Gravimetric.Energy, Stability.Charge, Atomic.Fraction.Discharge, Atomic.Fraction.Charge)

response <- numeric_data$Volumetric.Energy

set.seed(123)
train_index <- createDataPartition(response, p = 0.8, list = FALSE)
train_data <- predictors[train_index, ]
test_data <- predictors[-train_index, ]
train_response <- response[train_index]
test_response <- response[-train_index]

model <- lm(train_response ~ ., data = as.data.frame(train_data))

Podsumowanie modelu

Podsumowanie współczynników modelu regresji liniowej

Współczynnik	Szacunkowa wartość	Błąd standardowy	Statystyka t	Wartość p
(Intercept)	-176.170925	18.9096771	-9.316443	0
Gravimetric.Energy	2.992356	0.0349524	85.612423	0
Stability.Charge	2531.068883	95.3846901	26.535379	0
Atomic.Fraction.Discharge	2870.985836	187.7817116	15.288953	0
Atomic.Fraction.Charge	-3135.947619	211.9263282	-14.797348	0

Porównanie predykcji energii i rzeczywistych wartości

predictions <- predict(model, newdata = as.data.frame(test_data))

results <- data.frame(
  Predicted = predictions,
  Actual = test_response
)

prediction_volum <- ggplot(results, aes(x = Actual, y = Predicted, 
                          text = paste("Rzeczywiste: ", round(Actual, 2), "<br>Przewidywane: ", round(Predicted, 2)))) +
  geom_point() +
  geom_abline(slope = 1, intercept = 0, color = "red") +
  labs(
    title = "Rzeczywiste a przewidywane wartości energii wolumetrycznej",
    x = "Rzeczywiste",
    y = "Przewidywane"
  ) +
  theme_minimal()

ggplotly(prediction_volum, tooltip = "text")

Ocena modelu

rmse <- sqrt(mean((results$Actual - results$Predicted)^2))
mae <- mean(abs(results$Actual - results$Predicted))
r_squared <- cor(results$Actual, results$Predicted)^2

Przedział energii wolumetrycznej: 2.4162556, 6199.8937472

Jest to bardzo szeroki zakres, co wskazuje na dużą zmienność gęstości energii w różnych przypadkach. Przewidzenie wartości z dużego przedziału wpłynęło na trudność zadania.

Jednak wartości metryk są obiecujące:

• RMSE (Root Mean Square Error): 345.7721362
• MAE (Mean Absolute Error): 249.6212039
• R² (współczynnik determinacji): 0.8808561

Zwarzając na zakres rzeczywistej gęstości energii, uzyskane wartości RMSE oraz MAE świadczą o tym, że model radzi sobie stosunkowo dobrze, ale dla małych wartości może być mniej precyzyjny.

Zadowalający jest uzyskany współczynnik determinacji wynoszący 88.1%. Oznacza to, że model wyjaśnia większość zmienności zmiennej zależnej (energia wolumetryczna).

Możliwości ulepszenia

Można by było rozważyć zastosowanie technik takich jak standaryzacja lub transformacja danych, aby lepiej poradzić sobie z dużą zmiennością badanej cechy.

Również zastosowanie bardziej zaawansowanych modeli (np. modeli nieliniowych, zespołów drzew decyzyjnych) mogłoby poprawić predykcję.